home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / isapiter.dpr < prev    next >
Encoding:
Text File  |  1997-01-30  |  4.2 KB  |  142 lines
  1. {$IMAGEBASE $40000000}
  2. library ISAPIter;
  3.  
  4. { Important note about DLL memory management: ShareMem must be the
  5.   first unit in your library's USES clause AND your project's (select
  6.   View-Project Source) USES clause if your DLL exports any procedures or
  7.   functions that pass strings as parameters or function results. This
  8.   applies to all strings passed to and from your DLL--even those that
  9.   are nested in records and classes. ShareMem is the interface unit to
  10.   the DELPHIMM.DLL shared memory manager, which must be deployed along
  11.   with your DLL. To avoid using DELPHIMM.DLL, pass string information
  12.   using PChar or ShortString parameters. }
  13.  
  14. uses
  15.   SysUtils,
  16.   Classes,
  17.   NSAPI,
  18.   NSToIS;
  19.  
  20. function GetDocumentRoot(os: PHttpdObjSet): string;
  21. var
  22.   obj: PHttpdObject;
  23.   dt: PDtable;
  24.   dir: PDirective;
  25.   I, J: Integer;
  26. begin
  27.   Result := '';
  28.   if os <> nil then
  29.   begin
  30.     obj := objset_findbyname('default', nil, os);
  31.     if obj <> nil then
  32.     begin
  33.       dt := obj.dt;
  34.       for I := 0 to obj.nd - 1 do
  35.       begin
  36.         dir := dt.inst;
  37.         for J := 0 to dt.ni - 1 do
  38.         begin
  39.           if (dir <> nil) and (dir.param <> nil) then
  40.             if CompareText(NSstr2String(pblock_findval('fn', dir.param)), 'document-root') = 0 then
  41.             begin
  42.               Result := NSstr2String(pblock_findval('root', dir.param));
  43.               Exit;
  44.             end;
  45.           Inc(dir);
  46.         end;
  47.         Inc(dt);
  48.       end;
  49.     end;
  50.   end;
  51. end;
  52.  
  53. {!!! Resource this !!!}
  54. const
  55.   sInternalServerError = '<html><title>Internal Server Error 500</title>'#13#10 +
  56.     '<h1>Internal Server Error 500</h1><hr>'#13#10 +
  57.     'Exception: %s<br>'#13#10 +
  58.     'Message: %s<br></html>'#13#10;
  59.  
  60. function HandleServerException(E: Exception; pb: PPblock; sn: PSession; rq: Prequest): Integer;
  61. var
  62.   ResultText: string;
  63.   ContentLen: Integer;
  64. begin
  65.   if net_isalive(sn.csd) then
  66.   begin
  67.     http_status(sn, rq, PROTOCOL_SERVER_ERROR, PChar(E.Message));
  68.     ResultText := Format(sInternalServerError, [E.ClassName, E.Message]);
  69.     ContentLen := Length(ResultText);
  70.     param_free(pblock_remove('content-type', rq.srvhdrs));
  71.     pblock_nvinsert('content-type', 'text/html', rq.srvhdrs);
  72.     pblock_nninsert('content-length', ContentLen, rq.srvhdrs);
  73.     if http_start_response(sn, rq) <> REQ_NOACTION then
  74.       net_write(sn.csd, PChar(ResultText), ContentLen);
  75.   end;
  76.   Result := REQ_ABORTED;
  77. end;
  78.  
  79. procedure terminate_isapi(parameter: Pointer); cdecl; export;
  80. begin
  81.   DoneISAPIApplicationList;
  82. end;
  83.  
  84. function init_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  85. begin
  86.   InitISAPIApplicationList;
  87.   magnus_atrestart(terminate_isapi, nil);
  88.   Result := REQ_PROCEED;
  89. end;
  90.  
  91. function handle_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  92. var
  93.   DLLPath: string;
  94.   ISAPIApplication: TISAPIApplication;
  95.   ISAPISession: TISAPISession;
  96. begin
  97.   try
  98.     DLLPath := UnixPathToDosPath(NSstr2String(pblock_findval('dll-path', rq.vars)));
  99.     InitISAPIApplicationList;
  100.     ISAPIApplication := ISAPIApplicationList.LoadApplication(DLLPath);
  101.     ISAPISession := TISAPISession.Create(pb, sn, rq, ISAPIApplication);
  102.     try
  103.       ISAPISession.ProcessExtension;
  104.       Result := REQ_PROCEED;
  105.     finally
  106.       ISAPISession.Free;
  107.     end;
  108.   except
  109.     Result := HandleServerException(Exception(ExceptObject), pb, sn, rq);
  110.   end;
  111. end;
  112.  
  113. function check_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  114. var
  115.   Path, PathInfo: string;
  116. begin
  117.   try
  118.     Path := NSstr2String(pblock_findval('path', rq.vars));
  119.     pblock_nvinsert('dll-path', PChar(Path), rq.vars);
  120.     PathInfo := NSstr2String(pblock_findval('path-info', rq.vars));
  121.     pblock_nvinsert('path-translated', PChar(GetDocumentRoot(rq.os) + PathInfo), rq.vars);
  122.     Result := REQ_PROCEED;
  123.   except
  124.     Result := HandleServerException(Exception(ExceptObject), pb, sn, rq);
  125.   end;
  126. end;
  127.  
  128. function log_isapi(pb: PPblock; sn: PSession; rq: Prequest): Integer; cdecl; export;
  129. begin
  130.   InitISAPIApplicationList;
  131.   Result := ISAPIApplicationList.InitLog(pb, sn, rq);
  132. end;
  133.  
  134. exports
  135.   handle_isapi,
  136.   check_isapi,
  137.   log_isapi,
  138.   init_isapi;
  139.  
  140. begin
  141. end.
  142.